home *** CD-ROM | disk | FTP | other *** search
- *-----------------------------------------------------------------------
- *-- Program...: COLOR.PRG
- *-- Programmer: Ken Mayer (CIS: 71333,1030)
- *-- Date......: 07/28/1993
- *-- Notes.....: These routines are color processing routines that are
- *-- not in the main procedure file. See README.TXT for
- *-- details on how to use this library file.
- *-----------------------------------------------------------------------
-
- FUNCTION ColorOf
- *-----------------------------------------------------------------------
- *-- Programmer..: Jay Parsons (CIS: 72662,1302)
- *-- Date........: 01/11/1992
- *-- Notes.......: This function will return the color of a specified
- *-- area (as built in to dBASE).
- *-- Written for.: dBASE IV, 1.1
- *-- Rev. History: 01/11/1992 -- Original
- *-- Calls.......: ALLTRIM() Function in PROC.PRG
- *-- Called by...: Any
- *-- Usage.......: ColorOf("<cArea>")
- *-- Example.....: ?ColorOf("Messages")
- *-- Returns.....: Color (foreground/background)
- *-- Parameters..: cArea = Area you wish to return the color of from
- *-- list:
- *-- BOX/BOXES = Boxes
- *-- BORDER/PERIMETER = Border color
- *-- NORMAL = Normal screen/text
- *-- HIGHLIGHT = Highlights
- *-- MESSAGE = Messages
- *-- TITLE = Titles
- *-- INFORMATION = Information
- *-- FIELDS = Fields
- *-----------------------------------------------------------------------
-
- parameters cArea
-
- private cAttrib, cWanted, nPos
-
- m->cAttrib = set("ATTRIBUTES")
- m->cWanted = upper(alltrim(m->cArea))
-
- if m->cWanted = "BOX"
- m->nPos = 6
- else
- m->nPos = at(left(m->cWanted,4),;
- " NORM HIGH PERI MESS TITL BOXE INFO FIEL BORD") / 5
- if m->nPos = 9
- m->nPos = 3 && "Border" = "Perimeter"
- endif
- endif
-
- do case
- case m->nPos = 0
- m->cAttrib = "" && return null string for error
- case m->nPos < 4
- m->cAttrib = left(m->cAttrib,at("&",m->cAttrib) - 2)
- otherwise
- m->cAttrib = substr(m->cAttrib,at("&",m->cAttrib) + 3)
- m->nPos = m->nPos - 3
- endcase
- do while m->nPos > 1
- m->cAttrib = substr(m->cAttrib,at(",",m->cAttrib) + 1)
- m->nPos = m->nPos - 1
- enddo
-
- RETURN left(m->cAttrib,at(",",m->cAttrib+",")-1)
- *-- EoF: ColorOf()
-
- FUNCTION Attribyte
- *-----------------------------------------------------------------------
- *-- Programmer..: Jay Parsons (CIS: 72662,1302)
- *-- Date........: 03/19/1992
- *-- Notes.......: Converts a dBASE color code for an area to the
- *-- corresponding attribute byte as it is stored in video
- *-- RAM. Does not work for monochrome codes and does not
- *-- check for validity of color code given.
- *-- Written for.: dBASE IV, 1.1
- *-- Rev. History: 03/19/1992 -- Original
- *-- Calls.......: None
- *-- Called by...: Any
- *-- Usage.......: Attribyte(<cCode>)
- *-- Example.....: ? Attribyte("BG+/B")
- *-- Returns.....: Numeric = Attribute byte value, in example 27
- *-- (0001 1011b)
- *-- Parameters..: cCode = dBase code for colors of an area
- *-----------------------------------------------------------------------
-
- parameters cCode
- private nAttr,cHalf,nSlash
- m->nSlash=at("/",m->cCode)
- m->cHalf=trim(ltrim(iif(m->nSlash=0,"N",substr(m->cCode,;
- m->nSlash+1))))
- m->nAttr=16*(iif("B" $ m->cHalf,1,0)+iif("G" $ m->cHalf,2,0);
- +iif("R" $ m->cHalf,4,0)+iif("W" $ m->cHalf,7,0))
- m->cHalf=trim(ltrim(iif(m->nSlash=0,m->cCode,left(m->cCode,;
- m->nSlash-1))))
- m->nAttr=m->nAttr+iif("B" $ m->cHalf,1,0)+iif("G" $ m->cHalf,2,0);
- +iif("R" $ m->cHalf,4,0)+iif("W" $ m->cHalf,7,0)
- m->nAttr=m->nAttr+iif("+" $ m->cCode,8,0)+iif("*" $ m->cCode,128,0)
-
- RETURN iif("X" $ m->cCode, 0, m->nAttr)
- *-- EoF: Attribyte()
-
- FUNCTION Colorname
- *-----------------------------------------------------------------------
- *-- Programmer..: Jay Parsons (CIS: 72662,1302)
- *-- Date........: 03/19/1992
- *-- Notes.......: Converts an attribute value for an area to the name of
- *-- the corresponding color combination, assuming
- *-- Iscolor() = .T. Does not check for validity of
- *-- argument, integer 0<=arg<256
- *-- Written for.: dBASE IV, 1.1
- *-- Rev. History: 03/19/1992 -- Original
- *-- Calls.......: None
- *-- Called by...: Any
- *-- Usage.......: Colorname(<nAttr>)
- *-- Example.....: ? Colorname(27)
- *-- Returns.....: Character = Name of color combination, in example
- *-- "bright cyan on blue"
- *-- Parameters..: nAttr = value of attribute byte
- *-----------------------------------------------------------------------
-
- parameters nAttr
- private nColr,cName
- m->cName=iif(m->nAttr>127,"blinking ","")
- m->nColr=mod(m->nAttr,16)
- do case
- case m->nColr=8
- m->cName=m->cName+"gray"
- case m->nColr=14
- m->cName=m->cName+"yellow"
- otherwise
- if m->nColr>7
- m->cName=m->cName+"bright "
- endif
- m->cName=m->cName+trim(substr("black blue green cyan ";
- +"red magentabrown white ",mod(m->nColr,8)*7+1,7))
- endcase
- m->nColr = mod(int(m->nAttr/16),8)
- m->cName=m->cName+" on "+trim(substr("black blue green cyan ";
- +"red magentabrown white ",m->nColr*7+1,7))
-
- RETURN m->cName
- *-- EoF: Colorname()
-
- FUNCTION Colorcode
- *-----------------------------------------------------------------------
- *-- Programmer..: Jay Parsons (CIS: 72662,1302)
- *-- Date........: 03/19/1992
- *-- Notes.......: Converts an attribute value for an area to the dBase
- *-- code for the corresponding color combination, assuming
- *-- Iscolor() = .T. Does not check for validity of
- *-- argument, integer 0<=arg<256
- *-- Written for.: dBASE IV, 1.1
- *-- Rev. History: 03/19/1992 -- Original
- *-- Calls.......: None
- *-- Called by...: Any
- *-- Usage.......: Colorcode(<nAttr>)
- *-- Example.....: ? Colorcode(27)
- *-- Returns.....: Character = Code for color combination, in example
- *-- "BG+/B"
- *-- Parameters..: nAttr = value of attribute byte
- *-----------------------------------------------------------------------
-
- parameters nAttr
- private cColrs
- m->cColrs="N B G BGR RBGRW "
-
- RETURN trim(substr(m->cColrs,mod(m->nAttr,8)*2+1,2));
- +iif(mod(int(m->nAttr/8),2)>0,"+","");
- +iif(m->nAttr>127,"*","")+"/";
- +trim(substr(m->cColrs,mod(int(m->nAttr/16),8)*2+1,2))
- *-- EoF: Colorcode()
-
- PROCEDURE ReColor
- *-----------------------------------------------------------------------
- *-- Programmer..: Jay Parsons (CIS: 72662,1302)
- *-- Date........: 04/23/1992
- *-- Notes.......: Restores colors to those held in a string of the form
- *-- returned by set("ATTRIBUTE").
- *-- Written for.: dBASE IV, Versions 1.0 - 1.5.
- *-- Rev. History: 04/23/1992 -- Original
- *-- Calls : None
- *-- Called by...: Any
- *-- Usage.......: DO ReColor WITH <cColors>
- *-- Example.....: DO Recolor WITH OldColors
- *-- Parameters..: cColors = a string in the form returned by
- *-- set("ATTRIBUTE").
- *-- Side effects: Changes the screen colors.
- *-----------------------------------------------------------------------
-
- parameters cColors
- private cThis, cNext, nAt, cLeft, nX, cAreas
- m->cAreas = " NORMHIGHBORDMESSTITLBOX INFOFIEL"
- m->cLeft = m->cColors + ", "
- m->nX = 0
- do while m->nX < 8
- m->nX = m->nX + 1
- m->cThis = substr( m->cAreas, 4 * m->nX, 4 )
- if m->nX = 3
- m->nAt = at( "&", m->cLeft )
- m->cNext = left( m->cLeft, m->nAt - 2 )
- m->cLeft = substr( m->cLeft, m->nAt + 3 )
- SET COLOR TO , , &cNext.
- else
- m->nAt = at( ",", m->cLeft )
- m->cNext = left( m->cLeft, m->nAt - 1 )
- m->cLeft = substr( m->cLeft, m->nAt + 1 )
- SET COLOR OF &cThis. TO &cNext.
- endif
- enddo
-
- RETURN
- *-- EoP: ReColor
-
- FUNCTION NormColors
- *-----------------------------------------------------------------------
- *-- Programmer..: Jay Parsons (CIS: 72662,1302)
- *-- Date........: 02/23/1993
- *-- Notes.......: Returns the "normal" portion of a color string
- *-- Written for.: dBASE IV, Version 1.5.
- *-- Rev. History: 02/23/1993 -- Original Release
- *-- Calls.......: None
- *-- Called by...: Any
- *-- Usage.......: NormColors( <cColor> )
- *-- Example.....: ? NormColors( "N/BG,BG+/N,W+/B" )
- *-- Parameters..: cColor = String holding colors
- *-- Returns.....: Character, normal color portion of string.
- *-----------------------------------------------------------------------
-
- parameters cColor
- private cRet
- m->cRet = m->cColor
- if "," $ m->cRet
- m->cRet = left( m->cRet, at( ",", m->cRet ) - 1 )
- endif
-
- RETURN upper( ltrim( trim ( m->cRet ) ) )
- *-- EoF: NormColors()
-
- FUNCTION HighColors
- *-----------------------------------------------------------------------
- *-- Programmer..: Jay Parsons (CIS: 72662,1302)
- *-- Date........: 02/23/1993
- *-- Notes.......: Returns the "highlight" portion of a color string
- *-- Written for.: dBASE IV, Version 1.5.
- *-- Rev. History: 02/23/1993 -- Original Release
- *-- Calls.......: None
- *-- Called by...: Any
- *-- Usage.......: HighColors( <cColor> )
- *-- Example.....: ? HighColors( "N/BG,BG+/N,W+/B" )
- *-- Parameters..: cColor = String holding colors
- *-- Returns.....: Character, highlight color portion of string.
- *-- Returns empty string if no such portion.
- *-----------------------------------------------------------------------
-
- parameters cColor
- private cRet
- m->cRet = ""
- if "," $ m->cColor
- m->cRet = substr( m->cColor, at( ",",m->cColor ) + 1 )
- if "," $ m->cRet
- m->cRet = left( m->cRet, at( ",", m->cRet ) - 1 )
- endif
- endif
-
- RETURN upper( ltrim( trim( m->cRet ) ) )
- *-- EoF: HighColors()
-
- FUNCTION BordColors
- *-----------------------------------------------------------------------
- *-- Programmer..: Jay Parsons (CIS: 72662,1302)
- *-- Date........: 02/23/1993
- *-- Notes.......: Returns the "border" portion of a color string
- *-- Written for.: dBASE IV, Version 1.5.
- *-- Rev. History: 02/23/1993 -- Original Release
- *-- Calls.......: None
- *-- Called by...: Any
- *-- Usage.......: BordColors( <cColor> )
- *-- Example.....: ? BordColors( "N/BG,BG+/N,W+/B" )
- *-- Parameters..: cColor - String holding colors
- *-- Returns.....: Character, border color portion of string.
- *-- Returns empty string if no such portion.
- *-----------------------------------------------------------------------
-
- parameters cColor
- private cRet
- m->cRet = ""
- if "," $ m->cColor
- m->cRet = substr( m->cColor, at( ",",m->cColor ) + 1 )
- if "," $ m->cRet
- m->cRet = substr( m->cRet, at( ",", m->cRet ) + 1 )
- else
- m->cRet = ""
- endif
- endif
-
- RETURN upper( ltrim( trim( m->cRet ) ) )
- *-- EoF: BordColors()
-
- FUNCTION OppColor
- *-----------------------------------------------------------------------
- *-- Programmer..: Jay Parsons (CIS: 72662,1302)
- *-- Date........: 02/23/1993
- *-- Notes.......: Returns a color "opposite" the one given as its
- *-- parameter. Assumes iscolor().
- *-- You may substitute your own colors in the "cNew"
- *-- table.
- *-- If you do this, note that if you substitute the
- *-- same color for two or more colors, this function
- *-- is used on both colors and they are the original
- *-- foreground and background colors of some area, you
- *-- may finish with the foreground and background set
- *-- to the same color.
- *-- As furnished, the color returned is the one that would
- *-- result from performing a bitwise NOT on the R, G and
- *-- B bits of the parameter color. By using this
- *-- function twice, you restore the original color, the
- *-- technique used for animation.
- *-- Written for.: dBASE IV, Version 1.5.
- *-- Rev. History: 02/23/1993 -- Original Release
- *-- Calls.......: None
- *-- Called by...: Any
- *-- Usage.......: OppColor( <cColor> )
- *-- Example.....: ? OppColor( "N" )
- *-- Parameters..: cColor = String holding color to invert
- *-- Returns.....: Character, string holding inverted color
- *-----------------------------------------------------------------------
-
- parameters cColor
- private nAt, cRet, cOrig, cOld, cNew
-
- * ruler 12345678901234567890123456789012
- m->cOld = " N B G R BGB GRG RBR W"
- m->cNew = " W RG RB BG R B G N"
-
- m->cOrig = m->cColor
- m->cRet = ""
- if "*" $ m->cOrig
- m->cRet = m->cRet + "*"
- m->cOrig = stuff( m->cOrig, at( "*", m->cOrig ), 1, "" )
- endif
- if "+" $ m->cOrig
- m->cRet = m->cRet + "+"
- m->cOrig = stuff( m->cOrig, at( "+", m->cOrig ), 1, "" )
- endif
- m->nAt = 4 * int( at( m->cOrig, m->cOld ) / 4 )
- m->cRet = trim( substr( m->cNew, m->nAt, 2 ) ) + m->cRet
-
- RETURN m->cRet
- *-- EoF: OppColor()
-
- FUNCTION ForeColor
- *-----------------------------------------------------------------------
- *-- Programmer..: Jay Parsons (CIS: 72662,1302)
- *-- Date........: 02/24/1993
- *-- Notes.......: Returns foreground part of color string.
- *-- Written for.: dBASE IV, Version 1.5.
- *-- Rev. History: 02/24/1993 -- Original Release
- *-- 03/18/1993 -- bug returning "**" or "++" fixed
- *-- Calls.......: None
- *-- Called by...: Any
- *-- Usage.......: ForeColor( <cColor> )
- *-- Example.....: ? ForeColor( "N/BG" )
- *-- Parameters..: cColor = String holding color foreground and
- *-- background
- *-- Returns.....: Character, string with foreground portion of the color
- *-----------------------------------------------------------------------
-
- parameters cColor
- private cRet
- m->cRet = upper( trim( ltrim( m->cColor ) ) )
- if "/" $ m->cRet
- m->cRet = left( m->cRet, at( "/", m->cRet ) - 1 )
- endif
- if "*" $ m->cColor .and. .not. "*" $ m->cRet
- m->cRet = m->cRet + "*"
- endif
- if "+" $ m->cColor .and. .not. "+" $ m->cRet
- m->cRet = m->cRet + "+"
- endif
-
- RETURN m->cRet
- *-- EoF: ForeColor()
-
- FUNCTION BackColor
- *-----------------------------------------------------------------------
- *-- Programmer..: Jay Parsons (CIS: 72662,1302)
- *-- Date........: 02/24/1993
- *-- Notes.......: Returns background part of color string.
- *-- Written for.: dBASE IV, Version 1.5.
- *-- Rev. History: 02/04/1993 -- Original Release
- *-- Calls.......: None
- *-- Called by...: Any
- *-- Usage.......: BackColor( <cColor> )
- *-- Example.....: ? BackColor( "N/BG" )
- *-- Parameters..: cColor = String holding color foreground and
- *-- background
- *-- Returns.....: Character, string with background portion of the color.
- *-- Returns empty string if no such portion.
- *-------------------------------------------------------------------------------
-
- parameters cColor
- private cRet
- m->cRet = upper( trim( ltrim( m->cColor ) ) )
- if "/" $ m->cRet
- m->cRet = substr( m->cRet, at( "/", m->cRet ) + 1 )
- if "*" $ m->cRet
- m->cRet = stuff( m->cRet, at( "*", m->cRet ), 1, "" )
- endif
- if "+" $ m->cRet
- m->cRet = stuff( m->cRet, at( "+", m->cRet ), 1, "" )
- endif
- else
- m->cRet = ""
- endif
-
- RETURN upper( ltrim( trim( m->cRet ) ) )
- *-- EoF: BackColor()
-
- FUNCTION Bright
- *-----------------------------------------------------------------------
- *-- Programmer..: Bowen Moursund (CIS: 72662,436)
- *-- Date........: 07/30/1992
- *-- Notes.......: Bright() converts a dBASE color attribute string to
- *-- a bright (+) foreground.
- *-- Written for.: dBASE IV v1.5
- *-- Rev. History: 07/30/1992 -- Original
- *-- Calls.......: None
- *-- Called by...: Any
- *-- Usage.......: Bright( <cExp> )
- *-- Example.....: cBriteMsg = bright( ColorOf( "MESSAG" ) )
- *-- Returns.....: A color attribute string converted to bright
- *-- foreground.
- *-- Parameters..: <cExp> = cColor: a dBASE color attribute string
- *-----------------------------------------------------------------------
-
- parameter cColor
-
- RETURN iif( "+" $ cColor, cColor, cColor + "+" )
- *-- EoF: Bright()
-
- FUNCTION Dim
- *-----------------------------------------------------------------------
- *-- Programmer..: Bowen Moursund (CIS: 72662,436)
- *-- Date........: 07/30/1992
- *-- Notes.......: Dim() converts a dBASE color attribute string to
- *-- a non-bright ( no + ) foreground.
- *-- Written for.: dBASE IV v1.5
- *-- Rev. History: 07/30/1992 -- Original
- *-- Calls.......: None
- *-- Called by...: Any
- *-- Usage.......: Dim( <cExp> )
- *-- Example.....: cDimColor = dim( ColorOf( "NORMAL" ) )
- *-- Returns.....: A color attribute string converted to dim foreground.
- *-- Parameters..: <cExp> = cColor: a dBASE color attribute string
- *-----------------------------------------------------------------------
-
- parameter cColor
- private nPlusPos
- m->nPlusPos = at( "+", cColor )
-
- RETURN stuff( cColor, m->nPlusPos, iif( m->nPlusPos <> 0 , 1, 0 ), "" )
- *-- EoF: Dim()
-
- FUNCTION Blink
- *-----------------------------------------------------------------------
- *-- Programmer..: Bowen Moursund (CIS: 72662,436)
- *-- Date........: 07/30/1992
- *-- Notes.......: Blink() converts a dBASE color attribute string to
- *-- a blinking (*) foreground.
- *-- Written for.: dBASE IV v1.5
- *-- Rev. History: 07/30/1992 -- Original
- *-- Calls.......: None
- *-- Called by...: Any
- *-- Usage.......: Blink( <cExp> )
- *-- Example.....: cWarnColor = blink( ColorOf( "NORMAL" ) )
- *-- Returns.....: A color attribute string converted to blinking
- *-- foreground.
- *-- Parameters..: <cExp> = cColor: a dBASE color attribute string
- *-----------------------------------------------------------------------
-
- parameter cColor
-
- RETURN iif( "*" $ cColor, cColor, cColor + "*" )
- *-- EoF: Blink()
-
- FUNCTION NoBlink
- *-----------------------------------------------------------------------
- *-- Programmer..: Bowen Moursund (CIS: 72662,436)
- *-- Date........: 07/30/1992
- *-- Notes.......: NoBlink() converts a dBASE color attribute string to
- *-- a non-blinking ( no * ) foreground.
- *-- Written for.: dBASE IV v1.5
- *-- Rev. History: 07/30/1992 -- Original
- *-- Calls.......: None
- *-- Called by...: Any
- *-- Usage.......: NoBlink( <cExp> )
- *-- Example.....: cNoBlink = NoBlink( cWarnColor )
- *-- Returns.....: A color attribute string converted to non-blinking
- *-- foreground.
- *-- Parameters..: <cExp> = cColor: a dBASE color attribute string
- *-----------------------------------------------------------------------
-
- parameter cColor
- private nStrtPos
- nStrtPos = at( "*", cColor )
-
- RETURN stuff( cColor, m->nStrtPos, iif( m->nStrtPos <> 0, 1, 0 ), "" )
- *-- EoF: NoBlink()
-
- *-----------------------------------------------------------------------
- *-- EoP: COLOR.PRG
- *-----------------------------------------------------------------------